home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / OOPTUT34.ZIP / STREAMS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-14  |  12KB  |  390 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X-}
  2. {$M 4096,0,20000}
  3.  
  4. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  5. {   Turbo Pascal 6.0       Demo program from the Turbo Vision Guide.    }
  6. {                                                                       }
  7. {   TVGUID21.PAS    Copyright (c) 1990 by Borland International         }
  8. {                                                                       }
  9. {   Modification  10.8.91.    Further addition  21.11.92.               }
  10. {   Now provides screen display of details of Stream Registration and   }
  11. {   Graphical Shapes. DOS Debug is also used to display a memory check  }
  12. {   for the collection of graphical shapes and to inspect the stream    }
  13. {   file GRAPHICS.STM                                                   }
  14. {                                                                       }
  15. {   STREAMS.PAS  ->  .EXE    R Shaw    21.11.92                         }
  16. {                                                                       }
  17. {_______________________________________________________________________}
  18.  
  19. { Create and display a collection of graphical objects:
  20.   Points, Circles, Rectangles. Then put them on a stream
  21.   to be read by another program (TVGUID22.PAS).
  22.  
  23.   If you are running this program in the IDE, be sure to
  24.   enable the full graphics save option when you load TURBO.EXE:
  25.  
  26.     turbo -g
  27.  
  28.   This ensures that the IDE fully swaps video RAM and keeps
  29.   "dustclouds" from appearing on the user screen when in
  30.   graphics mode. You can enable this option permanently
  31.   via the Options|Environment|Startup dialog.
  32.  
  33.   This program uses the Graph unit and its .BGI driver files to
  34.   display graphics on your system. The "PathToDrivers"
  35.   constant defined below is now set to \TP\OOPTUTOR, instead of
  36.   \TP\BGI as in the original Borland program.
  37. }
  38.  
  39. program STREAMS;
  40.  
  41. uses
  42.    Dos, Objects, Graph, Crt, Hex;
  43.  
  44. const
  45.   PathToDrivers = '\TP\OOPTUTOR';
  46. var
  47.   answer     : char;
  48.   reply      : char;
  49.   MaxX, MaxY : integer;
  50.  
  51. { ********************************** }
  52. { ******  Graphical Objects  ******* }
  53. { ********************************** }
  54.  
  55. type
  56.   PGraphObject = ^TGraphObject;
  57.   TGraphObject = object(TObject)
  58.     X,Y: Integer;
  59.     constructor Init;
  60.     procedure Draw; virtual;
  61.     procedure Store(var S: TStream); virtual;
  62.   end;
  63.  
  64.   PGraphPoint = ^TGraphPoint;
  65.   TGraphPoint = object(TGraphObject)
  66.     procedure Draw; virtual;
  67.   end;
  68.  
  69.   PGraphCircle = ^TGraphCircle;
  70.   TGraphCircle = object(TGraphObject)
  71.     Radius: Integer;
  72.     constructor Init;
  73.     procedure Draw; virtual;
  74.     procedure Store(var S: TStream); virtual;
  75.   end;
  76.  
  77.   PGraphRect = ^TGraphRect;
  78.   TGraphRect = object(TGraphObject)
  79.     Width, Height: Integer;
  80.     constructor Init;
  81.     procedure Draw; virtual;
  82.     procedure Store(var S: TStream); virtual;
  83.   end;
  84.  
  85. { TGraphObject }
  86. constructor TGraphObject.Init;
  87. begin
  88.   X := Random(MaxX);
  89.   Y := Random(MaxY);
  90.   write('X = ',X:3,'   Y = ',Y:3);    {Added by RS to display values for  }
  91. end;                                  { checking by DOS Debug graphics.stm }
  92.  
  93. procedure TGraphObject.Draw;
  94. begin
  95.   Abstract;     { Give error: This object should never be drawn }
  96. end;
  97.  
  98. procedure TGraphObject.Store(var S: TStream);
  99. begin
  100.   S.Write(X, SizeOf(X));
  101.   S.Write(Y, SizeOf(Y));
  102. end;
  103.  
  104. { TGraphPoint }
  105. procedure TGraphPoint.Draw;
  106. var
  107.   DX, DY: Integer;
  108. begin
  109.   { Make it a fat point so you can see it }
  110.   for DX := x - 2 to x + 2 do
  111.     for DY := y - 2 to y + 2 do
  112.       PutPixel(DX, DY, 1);
  113. end;
  114.  
  115. { TGraphCircle }
  116. constructor TGraphCircle.Init;
  117. begin
  118.   TGraphObject.Init;                { RS addition will display X and Y }
  119.   Radius := 20 + Random(20);
  120.   Write('   Radius = ',Radius:3);   { RS addition to display radius for  }
  121. end;                                { checking by DOS Debug graphics.stm }
  122.  
  123. procedure TGraphCircle.Draw;
  124. begin
  125.   Circle(X, Y, Radius);
  126. end;
  127.  
  128. procedure TGraphCircle.Store(var S: TStream);
  129. begin
  130.   TGraphObject.Store(S);
  131.   S.Write(Radius, SizeOf(Radius));
  132. end;
  133.  
  134. { TGraphRect }
  135. constructor TGraphRect.Init;
  136. begin
  137.   TGraphObject.Init;               { RS addition will display X and Y }
  138.   Width := 10 + Random(20) + X;
  139.   Height := 6 + Random(15) + Y;
  140.   write('   Width = ',Width:3,'   Height = ',Height:3);  { RS addition to }
  141. end;                                                     { display width  }
  142.                                                          { and height     }
  143. procedure TGraphRect.Draw;
  144. begin
  145.   Rectangle(X, Y, X + Width, Y + Height);
  146. end;
  147.  
  148. procedure TGraphRect.Store(var S: TStream);
  149. begin
  150.   TGraphObject.Store(S);
  151.   S.Write(Width, SizeOf(Width));
  152.   S.Write(Height, SizeOf(Height));
  153. end;
  154.  
  155. { ********************************** }
  156. { **  Stream Registration Records ** }
  157. { ********************************** }
  158.  
  159. const
  160.   RGraphPoint: TStreamRec = (
  161.     ObjType: 150;
  162.     VmtLink: Ofs(TypeOf(TGraphPoint)^);
  163.     Load: nil;                             { No load method yet }
  164.     Store: @TGraphPoint.Store);
  165.  
  166.   RGraphCircle: TStreamRec = (
  167.     ObjType: 151;
  168.     VmtLink: Ofs(TypeOf(TGraphCircle)^);
  169.     Load: nil;                             { No load method yet }
  170.     Store: @TGraphCircle.Store);
  171.  
  172.   RGraphRect: TStreamRec = (
  173.     ObjType: 152;
  174.     VmtLink: Ofs(TypeOf(TGraphRect)^);
  175.     Load: nil;                             { No load method yet }
  176.     Store: @TGraphRect.Store);
  177.  
  178.  
  179. { ********************************** }
  180. { ************  Globals ************ }
  181. { ********************************** }
  182.  
  183. { Abort the program and give a message }
  184.  
  185. procedure Abort(Msg: String);
  186. begin
  187.   Writeln;
  188.   Writeln(Msg);
  189.   Writeln('Program aborting');
  190.   Halt(1);
  191. end;
  192.  
  193. { Register all object types that will be put onto the stream.
  194.   This includes standard TVision types, like TCollection.
  195. }
  196.  
  197. procedure StreamRegistration;
  198. begin
  199.   writeln('DETAILS OF STREAM REGISTRATION');
  200.   RegisterType(RCollection);
  201.   RegisterType(RGraphPoint);
  202.   Writeln;
  203.   writeln('RGraphPoint.ObjType: ',RGraphPoint.ObjType);
  204.   writeln('RGraphPoint.VmtLink: ',RGraphPoint.VmtLink);
  205.   writeln;
  206.   RegisterType(RGraphCircle);
  207.   writeln('RGraphCircle.ObjType: ',RGraphCircle.ObjType);
  208.   writeln('RGraphCircle.VmtLink: ',RGraphCircle.VmtLink);
  209.   writeln;
  210.   RegisterType(RGraphRect);
  211.   writeln('RGraphRect.ObjType: ',RGraphRect.ObjType);
  212.   writeln('RGraphRect.VmtLink: ',RGraphRect.VmtLink);
  213.   writeln;
  214.   write('Press any key to continue ');
  215.   answer := readkey;                     { Pause to view registration data }
  216.   ClrScr;
  217. end;
  218.  
  219. { Put the system into graphics mode }
  220.  
  221. procedure StartGraphics;
  222. var
  223.   Driver, Mode: Integer;
  224. begin
  225.   Driver := Detect;
  226.   InitGraph(Driver, Mode, PathToDrivers);
  227.   if GraphResult <> GrOK then
  228.   begin
  229.     Writeln(GraphErrorMsg(Driver));
  230.     if Driver = grFileNotFound then
  231.     begin
  232.       Writeln('in ', PathToDrivers,
  233.         '. Modify this program''s "PathToDrivers"');
  234.       Writeln('constant to specify the actual location of this file.');
  235.       Writeln;
  236.     end;
  237.     Writeln('Press Enter...');
  238.     Readln;
  239.     Halt(1);
  240.   end;
  241. end;
  242.  
  243. { Use the ForEach iterator to traverse and
  244.   show all the collection of graphical objects.
  245. }
  246.  
  247. procedure DrawAll(C: PCollection);
  248.  
  249. { Nested, far procedure. Receives one
  250.   collection element--a GraphObject, and
  251.   calls that elements Draw method.
  252. }
  253.  
  254. procedure CallDraw(P: PGraphObject); far;
  255. begin
  256.   P^.Draw;                            { Call Draw method }
  257. end;
  258.  
  259. begin { DrawAll }
  260.   C^.ForEach(@CallDraw);              { Draw each object }
  261. end;
  262.  
  263. { Instantiate and draw a collection of objects }
  264.  
  265. procedure MakeCollection(var List: PCollection);
  266. var
  267.   I: Integer;
  268.   P: PGraphObject;
  269. begin
  270.   { Initialize collection to hold 10 elements first, then grow by 5's }
  271.   List := New(PCollection, Init(10, 5));
  272.  
  273.   for I := 1 to 12 do
  274.   begin
  275.     case I mod 3 of                      { Create it }
  276.       0: P := New(PGraphPoint, Init);
  277.       1: P := New(PGraphCircle, Init);
  278.       2: P := New(PGraphRect, Init);
  279.     end;
  280.     writeln;
  281.     List^.Insert(P);                     { Add it to collection }
  282.   end;
  283.   writeln;
  284.   write('Press any key to continue ');
  285.   reply := readkey;                     { Pause to view data }
  286. end;
  287.  
  288.  
  289. Function DebugPath : Pathstr;
  290.  
  291. var
  292.   DPath : PathStr;
  293.  
  294. begin
  295.   DPath := '';
  296.   DPath := FSearch('DEBUG.EXE', GetEnv('PATH'));
  297.   If DPath = '' then DPath := FSearch('DEBUG.COM', GetEnv('PATH'));
  298.   If DPath = '' then
  299.      begin
  300.         writeln('DEBUG file not found. Please check your DOS system.');
  301.         writeln;
  302.         writeln('Press any key to continue: ');
  303.         repeat until keypressed;
  304.      end;
  305.   DebugPath := DPath;
  306. end;      {of Function DebugPath}
  307.  
  308.  
  309. { ********************************** }
  310. { **********  Main Program ********* }
  311. { ********************************** }
  312.  
  313. var
  314.   GraphicsList  : PCollection;
  315.   GraphicsStream: TBufStream;
  316.   
  317.  
  318.   HeapOrgSeg,HeapOrgOfs          : word;
  319.   HeapOrgSegX,HeapOrgOfsX        : string;
  320.   HeapPtrSeg,HeapPtrOfs          : word;
  321.   HeapPtrSegX,HeapPtrOfsX        : string;
  322.   HeapOrg                        : ^integer;
  323.   i                              : integer;
  324.  
  325.  
  326. begin
  327.   ClrScr;
  328.  
  329.   Writeln;
  330.   Mark(HeapOrg);
  331.   HeapOrgSeg := seg(HeapOrg^);
  332.   HeapOrgOfs := ofs(HeapOrg^);
  333.   
  334.   dec2hex(HeapOrgSeg,HeapOrgSegX);
  335.   dec2hex(HeapOrgOfs,HeapOrgOfsX);
  336.  
  337.  
  338.   Randomize;
  339.   StreamRegistration;                   { Register all streams }
  340.   StartGraphics;                        { Activate graphics }
  341.   MaxX := GetMaxX;
  342.   MaxY := GetMaxY;
  343.   Closegraph;
  344.   TextMode(3);                          { Switch back to text mode }
  345.   for i := HeapOrgOfs to (HeapOrgOfs + 1000) do Mem[HeapOrgSeg:i] := 0;
  346.   writeln('DETAILS OF GRAPHICAL SHPAES');
  347.   writeln;
  348.  
  349.   { Make the collection }
  350.   MakeCollection(GraphicsList);         { Generate and collect figures }
  351.   HeapPtrSeg := seg(HeapPtr^);
  352.   HeapPtrOfs := ofs(HeapPtr^);
  353.   dec2hex(HeapPtrSeg,HeapPtrSegX);
  354.   dec2hex(HeapPtrOfs,HeapPtrOfsX);
  355.   
  356.  
  357.  
  358.   StartGraphics;                        { Re-activate graphics }
  359.   DrawAll(GraphicsList);                { Use iterator to draw all }
  360.   OutTextXY(10,470,'Press any key to continue ');
  361.   reply := readkey;                     { Pause to view figures }
  362.  
  363.   { Put the collection in a stream on disk }
  364.   GraphicsStream.Init('GRAPHICS.STM', stCreate, 1024);
  365.   GraphicsStream.Put(GraphicsList);     { Output collection }
  366.   GraphicsStream.Done;                  { Shut down stream }
  367.   CloseGraph;
  368.   TextMode(3);
  369.   writeln('CHECK OF MEMORY FOR THE COLLECTION OF GRAPHICAL SHAPES.');
  370.   writeln;
  371.   writeln('HeapOrg:    ',HeapOrgSegX,':',HeapOrgOfsX);
  372.   writeln('HeapPtr:    ',HeapPtrSegX,':',HeapPtrOfsX);
  373.   writeln;
  374.   writeln('DOS Debug now entered from program by means of Exec procedure.');
  375.   writeln('Please type D followed by a space and then the HeapOrg address, as above.');
  376.   writeln('Then continue to type D until end of collection. Then type Q.');
  377.   SwapVectors;
  378.   Exec(DebugPath,'');
  379.   If DosError <> 0 then writeln('Dos error # ',DosError);
  380.   ClrScr;
  381.   writeln('DOS Debug now used to inspect the stream file GRAPHICS.STM.');
  382.   writeln('Just type D to inspect and eventually type Q to quit.');
  383.   writeln;
  384.   Exec(DebugPath,'graphics.stm');
  385.   If DosError <> 0 then writeln('Dos error # ',DosError);
  386.   SwapVectors;
  387.   { Clean up }
  388.   Dispose(GraphicsList, Done);          { Delete collection }
  389. end.
  390.